home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / gfxfx / fractal.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-20  |  1.6 KB  |  77 lines
  1. {$G+,N+,E-}
  2.  
  3. { Reals   Complex
  4.    -1        0
  5.    -0.1      0.8
  6.     0.3     -0.5
  7.    -1.139    0.238
  8. }
  9.  
  10. program Julia;
  11. { Julia Fractal, uses hardcoded ET4000 SVGA mode! By Bas van Gaalen, Holland, PD }
  12. const vseg : word = $a000;
  13. type real = double;
  14. var cx,cy,xo,yo,x1,y1 : real; mx,my,a,b,i,orb : word;
  15.  
  16. procedure setpal(col,r,g,b : byte); assembler;
  17. asm
  18.   mov dx,03c8h
  19.   mov al,col
  20.   out dx,al
  21.   inc dx
  22.   mov al,r
  23.   out dx,al
  24.   mov al,g
  25.   out dx,al
  26.   mov al,b
  27.   out dx,al
  28. end;
  29.  
  30. procedure putpixel(xp,yp : word; col : byte); assembler;
  31. asm
  32.   mov es,vseg
  33.   mov ax,yp
  34.   mov dx,640
  35.   mul dx
  36.   add ax,xp
  37.   adc dx,0
  38.   mov di,ax
  39.   mov al,dl
  40.   mov dx,03cdh
  41.   out dx,al
  42.   mov al,col
  43.   mov [es:di],al
  44. end;
  45.  
  46. function keypressed : boolean; assembler;
  47. asm
  48.   mov ah,0bh
  49.   int 21h
  50.   and al,0feh
  51. end;
  52.  
  53. begin
  54.   write('Real part: '); readln(cx);
  55.   write('Imaginary part: '); readln(cy);
  56.   asm mov ax,2eh; int 10h; end;
  57.   for i := 1 to 64 do setpal(i,10+i div 3,10+i div 3,15+round(i/1.306122449));
  58.   mx := 639; my := 479;
  59.   for a := 1 to mx  do
  60.     for b := 1 to my do begin
  61.       xo := -2+a/(mx/4); { X complex plane coordinate }
  62.       yo :=  2-b/(my/4); { Y complex plane coordinate }
  63.       orb := 0; i := 0;
  64.       repeat
  65.         x1 := xo*xo-yo*yo+cx;
  66.         y1 := 2*xo*yo+cy;
  67.         xo := x1;
  68.         yo := y1;
  69.         inc(i);
  70.       until (i = 64) or (x1*x1+y1*y1 > 4) or (abs(x1) > 2) or (abs(y1) > 2);
  71.       if i <> 64 then orb := i;
  72.       putpixel(a,b,orb); { Plot orbit }
  73.     end;
  74.   while not keypressed do;
  75.   asm mov ax,3; int 10h; end;
  76. end.
  77.